home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Caml Light 0.7 / Caml Light 0.7 source / src / lex / output.ml < prev    next >
Text File  |  1995-06-10  |  4KB  |  80 lines
  1. (* Generating a DFA as a set of mutually recursive functions *)
  2.  
  3. #open "syntax";;
  4. #open "sort";;
  5.  
  6. let ic = ref std_in
  7. and oc = ref std_out;;
  8.  
  9. (* 1- Generating the actions *)
  10.  
  11. let copy_buffer = create_string 1024;;
  12.  
  13. let copy_chunk (Location(start,stop)) =
  14.   let rec copy s =
  15.     if s <= 0 then () else
  16.       let n = if s < 1024 then s else 1024 in
  17.       let m = input !ic copy_buffer 0 n in
  18.         output !oc copy_buffer 0 m;
  19.         copy (s - m)
  20.   in
  21.     seek_in !ic start;
  22.     copy (stop - start)
  23. ;;
  24.  
  25. let output_action (i,act) =
  26.   output_string !oc ("action_" ^ string_of_int i ^ " lexbuf = (\n");
  27.   copy_chunk act;
  28.   output_string !oc ")\nand ";
  29.   ()
  30. ;;
  31.  
  32. (* 2- Generating the states *)
  33.  
  34. let states = ref ([||] : automata vect);;
  35.  
  36. let enumerate_vect v =
  37.   let rec enum env pos =
  38.     if pos >= vect_length v then env else
  39.       try
  40.         let pl = assoc v.(pos) env in
  41.           pl := pos :: !pl; enum env (succ pos)
  42.         with Not_found ->
  43.           enum ((v.(pos), ref [pos]) :: env) (succ pos) in
  44.     sort
  45.       (fun (e1, ref pl1) (e2, ref pl2) -> list_length pl1 >= list_length pl2)
  46.       (enum [] 0)
  47. ;;
  48.  
  49. let output_move = function
  50.     Backtrack ->
  51.       output_string !oc "backtrack lexbuf"
  52.   | Goto dest ->
  53.       match !states.(dest) with
  54.         Perform act_num ->
  55.           output_string !oc ("action_" ^ string_of_int act_num ^ " lexbuf")
  56.       | _ ->
  57.           output_string !oc ("state_" ^ string_of_int dest ^ " lexbuf")
  58. ;;
  59.  
  60. (* This is not char_for_read because of newlines on cross-compilers *)
  61. let escape_char = function
  62.     `\`` -> "\\`"
  63.   | `\\` -> "\\\\"
  64.   | `\t` -> "\\t"
  65.   | c ->  if is_printable c then
  66.             make_string 1 c
  67.           else begin
  68.             let n = int_of_char c in
  69.             let s = create_string 4 in
  70.             set_nth_char s 0 `\\`;
  71.             set_nth_char s 1 (char_of_int (48 + n / 100));
  72.             set_nth_char s 2 (char_of_int (48 + (n / 10) mod 10));
  73.             set_nth_char s 3 (char_of_int (48 + n mod 10));
  74.             s
  75.           end
  76. ;;
  77.  
  78. let rec output_chars = function
  79.     [] ->
  80.